unit UHook;

interface

uses Windows, Messages, SysUtils, Controls, Grids;

procedure InstallHook(MainWnd, DestWnd: HWND); stdcall;
procedure UninstallHook; stdcall;
function GetHookedCell: PChar; stdcall;

implementation

uses UShare;

var
  ControlAtom: TAtom;
  ControlAtomString: string;
  RM_GetObjectInstance: DWORD;  // registered window message

function FindControl(Handle: HWnd): TWinControl;
var
  OwningProcess: DWORD;
begin
  Result := nil;
  if (Handle <> 0) and (GetWindowThreadProcessID(Handle, OwningProcess) <> 0) and
     (OwningProcess = GetCurrentProcessId) then
  begin
    if GlobalFindAtom(PChar(ControlAtomString)) = ControlAtom then
      Result := Pointer(GetProp(Handle, MakeIntAtom(ControlAtom)))
    else
      Result := Pointer(SendMessage(Handle, RM_GetObjectInstance, 0, 0));
  end;
end;

function MsgWndProc(hwnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
var
  SG: TStringGrid;
  X, Y: Integer;
  CellBuff: String;
begin
  case Msg of
    CM_QUERYROW:
      begin
        Result := -1;
        if P^.DestWnd <> 0 then
        begin
          SG := Pointer(FindControl(P^.DestWnd));
          if SG <> nil then Result := SG.RowCount;
        end;
        Exit;
      end;
    CM_QUERYCOL:
      begin
        Result := -1;
        if P^.DestWnd <> 0 then
        begin
          SG := Pointer(FindControl(P^.DestWnd));
          if SG <> nil then Result := SG.ColCount;
        end;
        Exit;
      end;
    CM_HOOKCELL:
      begin
        Result := -1;
        P^.Text[0] := #0;
        if P^.DestWnd <> 0 then
        begin
          SG := Pointer(FindControl(P^.DestWnd));
          if SG <> nil then
          begin
            X := WParam;
            Y := LParam;
            if (X >= 0) and (X < SG.ColCount) and (Y >= 0) and (Y < SG.RowCount) then
            begin
              Result := Length(SG.Cells[X, Y]);
              if Result > 0 then
              begin
                StrPLCopy(P^.Text, SG.Cells[X, Y], 1024);
              end;
            end;
          end;
        end;
        Exit;
      end;
  end;
  Result := DefWindowProc(hwnd, Msg, WParam, LParam);
end;

function GetMsgProc(Code: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
begin
  if Code = HC_ACTION then
  begin
  end;
  Result := CallNextHookEx(P^.hkMsg, Code, WParam, LParam);
end;

procedure InstallHook(MainWnd, DestWnd: HWND); stdcall;
begin
  if P^.hkMsg = 0 then
    P^.hkMsg := SetWindowsHookEx(WH_GETMESSAGE, @GetMsgProc, HInstance, 0);
  P^.HostWnd := MainWnd;
  P^.HostPID := GetCurrentProcessId;
  P^.DestWnd := DestWnd;
end;

procedure UninstallHook; stdcall;
begin
  if P^.hkMsg <> 0 then
  begin
    UnhookWindowsHookEx(P^.hkMsg);
    P^.hkMsg := 0;
  end;
end;

function GetHookedCell: PChar; stdcall;
begin
  Result := P^.Text;
end;

var
  DoClear: Boolean;
  DestPID: DWORD;
  DestProcess: Boolean = False;
  UtilWindowClass: TWndClass = (
    style: 0;
    lpfnWndProc: @MsgWndProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: 0;
    lpszMenuName: nil;
    lpszClassName: 'THookSGMsgWindow');

initialization
  hMapFile := OpenFileMapping(FILE_MAP_WRITE, False, cMapFileName);
  DoClear := hMapFile = 0;
  if hMapFile = 0 then
    hMapFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE,
      0, SizeOf(TShareData), cMapFileName);
  P := MapViewOfFile(hMapFile, FILE_MAP_WRITE, 0, 0, 0);
  if DoClear then FillChar(P^, SizeOf(TShareData), 0);
  ControlAtomString := Format('ControlOfs%.8X%.8X', [GetModuleHandle(nil), GetCurrentThreadID]);
  ControlAtom := GlobalAddAtom(PChar(ControlAtomString));
  RM_GetObjectInstance := RegisterWindowMessage(PChar(ControlAtomString));
  if P^.DestWnd <> 0 then
  begin
    GetWindowThreadProcessId(P^.DestWnd, DestPID);
    if DestPID = GetCurrentProcessId then
    begin
      DestProcess := True;
      UtilWindowClass.hInstance := HInstance;
      RegisterClass(UtilWindowClass);
      P^.MsgWnd := CreateWindowEx(
        WS_EX_TOOLWINDOW,              // extended window style
        UtilWindowClass.lpszClassName, // pointer to registered class name
        UtilWindowClass.lpszClassName, // pointer to window name
        WS_POPUP,                      // window style
        0,                             // horizontal position of window
        0,                             // vertical position of window
        0,                             // window width
        0,                             // window height
        0,                             // handle to parent or owner window
        0,                             // handle to menu, or child-window identifier
        HInstance,                     // handle to application instance
        nil);                          // pointer to window-creation data
      PostMessage(P^.HostWnd, CM_MSGWNDCREATED, P^.MsgWnd, 1);
    end;
  end;
finalization
  if DestProcess then
  begin
    DestroyWindow(P^.MsgWnd);
    PostMessage(P^.HostWnd, CM_MSGWNDCREATED, P^.MsgWnd, 0);
  end;
  GlobalDeleteAtom(ControlAtom);
  ControlAtomString := '';
  UnmapViewOfFile(P);
  CloseHandle(hMapFile);
end.
